home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / COMPTOOL / CALLDLLS / DECLARES.BAS < prev    next >
Encoding:
BASIC Source File  |  1996-11-15  |  6.2 KB  |  167 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. Dim WinVersion As Integer, SoundAvailable As Integer
  4. Global VisibleFrame As Frame
  5.  
  6. Global Const TWIPS = 1
  7. Global Const PIXELS = 3
  8. Global Const RES_INFO = 2
  9. Global Const MINIMIZED = 1
  10.  
  11. Type MYVERSION
  12.     lMajorVersion As Long
  13.     lMinorVersion As Long
  14.     lExtraInfo As Long
  15. End Type
  16.  
  17. Type OSVERSIONINFO
  18.         dwOSVersionInfoSize As Long
  19.         dwMajorVersion As Long
  20.         dwMinorVersion As Long
  21.         dwBuildNumber As Long
  22.         dwPlatformId As Long
  23.         szCSDVersion As String * 128      '  Maintenance string for PSS usage
  24. End Type
  25.  
  26. Type Rect
  27.     Left As Integer
  28.     Top As Integer
  29.     Right As Integer
  30.     Bottom As Integer
  31. End Type
  32.  
  33. Public Type SystemInfo
  34.     dwOemId As Long
  35.     dwPageSize As Long
  36.     lpMinimumApplicationAddress As Long
  37.     lpMaximumApplicationAddress As Long
  38.     dwActiveProcessorMask As Long
  39.     dwNumberOfProcessors As Long
  40.     dwProcessorType As Long
  41.     dwAllocationGranularity As Long
  42.     dwReserved As Long
  43. End Type
  44.  
  45. Public Type MEMORYSTATUS
  46.     dwLength As Long
  47.     dwMemoryLoad As Long
  48.     dwTotalPhys As Long
  49.     dwAvailPhys As Long
  50.     dwTotalPageFile As Long
  51.     dwAvailPageFile As Long
  52.     dwTotalVirtual As Long
  53.     dwAvailVirtual As Long
  54. End Type
  55.  
  56. Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  57. Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SystemInfo)
  58. Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
  59. Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
  60. Declare Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long
  61. Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
  62. Declare Function TrackPopupMenu Lib "User32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hWnd As Long, lpReserved As Any) As Long
  63. Declare Function GetMenu Lib "User32" (ByVal hWnd As Long) As Long
  64. Declare Function GetSubMenu Lib "User32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
  65. Declare Function GetDesktopWindow Lib "User32" () As Long
  66. Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
  67. Declare Function ReleaseDC Lib "User32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
  68. Declare Function BitBlt Lib "GDI32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
  69. Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
  70. Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  71. Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
  72. Declare Function waveOutGetNumDevs Lib "winmm" () As Long
  73. Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
  74. Declare Function sndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  75.  
  76. Global Const VER_PLATFORM_WIN32s = 0
  77. Global Const VER_PLATFORM_WIN32_WINDOWS = 1
  78. Global Const VER_PLATFORM_WIN32_NT = 2
  79.  
  80. Global Const WF_CPU286 = &H2&
  81. Global Const WF_CPU386 = &H4&
  82. Global Const WF_CPU486 = &H8&
  83. Global Const WF_STANDARD = &H10&
  84. Global Const WF_ENHANCED = &H20&
  85. Global Const WF_80x87 = &H400&
  86.  
  87. Global Const SM_MOUSEPRESENT = 19
  88.  
  89. Global Const GFSR_SYSTEMRESOURCES = &H0
  90. Global Const GFSR_GDIRESOURCES = &H1
  91. Global Const GFSR_USERRESOURCES = &H2
  92.  
  93. Global Const MF_POPUP = &H10
  94. Global Const MF_BYPOSITION = &H400
  95. Global Const MF_SEPARATOR = &H800
  96.  
  97. Global Const SRCCOPY = &HCC0020
  98. Global Const SRCERASE = &H440328
  99. Global Const SRCINVERT = &H660046
  100. Global Const SRCAND = &H8800C6
  101.  
  102. Global Const HWND_TOPMOST = -1
  103. Global Const HWND_NOTOPMOST = -2
  104. Global Const SWP_NOACTIVATE = &H10
  105. Global Const SWP_SHOWWINDOW = &H40
  106.  
  107.  
  108. Function DeviceColors(hDC As Long) As Single
  109. Const PLANES = 14
  110. Const BITSPIXEL = 12
  111.     DeviceColors = 2 ^ (GetDeviceCaps(hDC, PLANES) * GetDeviceCaps(hDC, BITSPIXEL))
  112. End Function
  113.  
  114. Function GetSysIni(section, key)
  115. Dim retVal As String, AppName As String, worked As Integer
  116.     retVal = String$(255, 0)
  117.     worked = GetPrivateProfileString(section, key, "", retVal, Len(retVal), "System.ini")
  118.     If worked = 0 Then
  119.         GetSysIni = "unknown"
  120.     Else
  121.         GetSysIni = Left(retVal, InStr(retVal, Chr(0)) - 1)
  122.     End If
  123. End Function
  124.  
  125. Function GetWinIni(section, key)
  126. Dim retVal As String, AppName As String, worked As Integer
  127.     retVal = String$(255, 0)
  128.     worked = GetProfileString(section, key, "", retVal, Len(retVal))
  129.     If worked = 0 Then
  130.         GetWinIni = "unknown"
  131.     Else
  132.         GetWinIni = Left(retVal, InStr(retVal, Chr(0)) - 1)
  133.     End If
  134. End Function
  135.  
  136. Function SystemDirectory() As String
  137. Dim WinPath As String
  138.     WinPath = String(145, Chr(0))
  139.     SystemDirectory = Left(WinPath, GetSystemDirectory(WinPath, InStr(WinPath, Chr(0)) - 1))
  140. End Function
  141.  
  142. Function WindowsDirectory() As String
  143. Dim WinPath As String
  144. Dim temp
  145.     WinPath = String(145, Chr(0))
  146.     temp = GetWindowsDirectory(WinPath, 145)
  147.     WindowsDirectory = Left(WinPath, InStr(WinPath, Chr(0)) - 1)
  148. End Function
  149.  
  150. Function WindowsVersion() As MYVERSION
  151. Dim myOS As OSVERSIONINFO, WinVer As MYVERSION
  152. Dim lResult As Long
  153.  
  154.     myOS.dwOSVersionInfoSize = Len(myOS)    'should be 148
  155.     
  156.     lResult = GetVersionEx(myOS)
  157.         
  158.     'Fill user type with pertinent info
  159.     WinVer.lMajorVersion = myOS.dwMajorVersion
  160.     WinVer.lMinorVersion = myOS.dwMinorVersion
  161.     WinVer.lExtraInfo = myOS.dwPlatformId
  162.     
  163.     WindowsVersion = WinVer
  164.  
  165. End Function
  166.  
  167.